home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / demos / 57 / pascal / real.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-09-18  |  11.1 KB  |  291 lines
  1. (*
  2.  
  3.            Personal Pascal routine to convert REALS to STRINGS,
  4.                                    by
  5.                        Doug Harrison, PPN 72277,2315.
  6.  
  7.     Please send any comments, friendly criticisms, etc. to me. I've used
  8.     this routine extensively and have found no bugs in this version to
  9.     date. Compile it and declare it EXTERNAL in your program, and specify
  10.     it as an additional link file, or simply include the procedure as is,
  11.     after removing the compiler directives and dummy program shell.
  12.     REAL_TO_STRING allows one to state the number of digits to be displayed
  13.     right of the decimal and whether or not to express the string in
  14.     scientific notation or in expanded form, i.e. 2e22 = 2 followed by 22
  15.     zeroes. Enjoy!
  16.  
  17.  *)
  18.  
  19.  
  20. {$M+}
  21. {$E+}
  22. PROGRAM mock;
  23.  
  24. PROCEDURE REAL_TO_STRING (     real_num    : REAL;
  25.                            VAR string_real : STRING;
  26.                                digits      : INTEGER;
  27.                                sci_not     : BOOLEAN );
  28.  
  29. (* real_num    : real number to be converted into a string
  30.    string_real : working variable that also passes string result to caller
  31.    digits      : specifies # of digits to be displayed right of decimal,
  32.                  valid values are 0-8
  33.    sci_not     : flag which determines whether to express in sci. not. or not
  34. *)
  35.  
  36. (* FORMAT of string returned is:
  37.    sci. not.:
  38.               sign ( - or SPACE ), #.#####... , E, sign ( - or nothing ), ##.
  39.    non-sci. not. :
  40.                   sign ( - or SPACE ), ####.####.
  41. *)
  42.  
  43. (* Round-off errors of the nature x.xxxxxxx999 are corrected; consequently,
  44.    any number with a sequence of 3 or more terminal 9's
  45.    is affected, even if this is NOT an artifact. This should rarely be a
  46.    problem. Also, if a number is to be expressed in expanded form, the
  47.    magnitude of the exponent plus the # of digits to be displayed can not
  48.    exceed 8, since LONG_ROUND generates long_ints- size < 2e9. This is not
  49.    too severe a problem since only 11 digits of precision are supported
  50.    anyway. That is, specifying 4 digits for the # 100,000,000.9012 is
  51.    meaningless since the number is rounded to 100,000,000.9 as it becomes
  52.    a REAL. The last digits are unavailable to real_to_string. In such
  53.    cases, no action is performed on the number- it emerges untouched by
  54.    the rounding function. Also, note that the detection of 999 occurs after
  55.    conversion to 1 <= mag_num < 10. Thus, 99,999,999,999 becomes 9.9999999999
  56.    which indicates a rounding error.
  57. *)
  58.  
  59.   TYPE STR1           = STRING [ 1 ];
  60.  
  61.   VAR   mag_num       : REAL;
  62.         c ,i , j, len,
  63.         start_delete,
  64.         end_delete    : INTEGER;
  65.         sign_exp      : STR1;
  66.         temp          : STRING;
  67.         found         : BOOLEAN;
  68.         last          : ARRAY [ 1..11 ] OF STR1;
  69.  
  70.  
  71.  
  72.   PROCEDURE ADJUST_TO_SPECIFIED_PRECISION;
  73.  
  74.      (* adjusts appearance following rounding *)
  75.  
  76.      VAR dec_pos : INTEGER;
  77.  
  78.      BEGIN
  79.  
  80.         dec_pos := POS ( '.' , string_real );
  81.         WHILE LENGTH ( string_real ) < dec_pos + digits DO
  82.               string_real := CONCAT ( string_real , '0' );
  83.         WHILE LENGTH ( string_real ) > dec_pos + digits DO
  84.                   DELETE ( string_real , LENGTH ( string_real ) , 1 );
  85.         IF POS ( '.' , string_real ) = LENGTH ( string_real )
  86.         THEN DELETE ( string_real , LENGTH ( string_real ) , 1 );
  87.  
  88.      END; (* adjust_to_specified_precision *)
  89.  
  90.  
  91.  
  92.   PROCEDURE SUCCESSOR ( VAR num : STR1 );
  93.  
  94.      (* used to "increment" a string digit *)
  95.  
  96.      BEGIN
  97.         IF num = '8'
  98.         THEN num := '9';
  99.         IF num = '7'
  100.         THEN num := '8';
  101.         IF num = '6'
  102.         THEN num := '7';
  103.         IF num = '5'
  104.         THEN num := '6';
  105.         IF num = '4'
  106.         THEN num := '5';
  107.         IF num = '3'
  108.         THEN num := '4';
  109.         IF num = '2'
  110.         THEN num := '3';
  111.         IF num = '1'
  112.         THEN num := '2';
  113.         IF num = '0'
  114.         THEN num := '1';
  115.      END; (* SUCCESSOR *)
  116.  
  117.  
  118.  
  119.   BEGIN (* REAL_TO_STRING *)
  120.  
  121.      IF real_num <> 0.0  (* necessary for conversion to #.######### format *)
  122.      THEN BEGIN
  123.               IF real_num < 0.0            (* sign of number *)
  124.               THEN string_real := '-'
  125.               ELSE string_real := ' ';
  126.               mag_num := ABS (real_num);   (* got sign, so work with number
  127.                                               magnitude ! *)
  128.               c := 0;                      (* c counts the number of times the
  129.                                               number can be multiplied or div-
  130.                                               ided by 10 so that finally
  131.                                               1 <= number < 10            *)
  132.               IF mag_num >= 10.0           (* make 1 <= number < 10, can't do
  133.                                               if number = 0! *)
  134.               THEN REPEAT
  135.                         mag_num := mag_num / 10.0;
  136.                         c := c+1;
  137.                    UNTIL mag_num < 10.0
  138.               ELSE IF mag_num < 1.0
  139.                    THEN REPEAT
  140.                              mag_num := mag_num * 10.0;
  141.                              c := c+1;
  142.                         UNTIL mag_num >= 1.0;
  143.  
  144.               (* Round mag_num to specified # of digits *)
  145.  
  146.               IF  ( sci_not ) AND ( digits <= 8 )
  147.               THEN mag_num := LONG_ROUND ( mag_num * PwrOfTen ( digits ) ) /
  148.                                          PwrOfTen ( digits );
  149.  
  150.               IF ( NOT sci_not ) AND ( ( c + digits ) <= 8 )
  151.               THEN mag_num := LONG_ROUND ( mag_num * PwrOfTen ( c+ digits ) ) /
  152.                                          PwrOfTen ( c + digits );
  153.  
  154.               (* reals have 11 digits of precision   *)
  155.               (* convert REAL to a string equivalent *)
  156.  
  157.               FOR i := 1 TO 11 DO
  158.                   BEGIN
  159.                          j := TRUNC (mag_num);
  160.                          string_real := CONCAT ( string_real , CHR ( j + 48 ));
  161.                          mag_num := ( mag_num - j ) * 10.0;
  162.                          IF i = 1
  163.                          THEN string_real := CONCAT ( string_real , '.' );
  164.                   END; (* FOR i  *)
  165.  
  166.               IF (( real_num < 1.0 ) AND ( real_num > 0.0 ))  OR
  167.                  (( real_num < 0.0 ) AND ( real_num > -1.0 ))
  168.               THEN sign_exp := '-'
  169.               ELSE sign_exp := '';
  170.  
  171.  
  172.               (* Get rid of artifactual "999" generated, if any *)
  173.  
  174.               temp := COPY ( string_real , 4 , 10 );
  175.  
  176.               i := 10;
  177.               found := FALSE;
  178.  
  179.               WHILE ( NOT found ) AND ( i >= 1 ) DO
  180.                   IF temp [ i ] <> '9'
  181.                   THEN found := TRUE
  182.                   ELSE i := i - 1;
  183.               i := i + 1;
  184.  
  185.               IF i <= 8
  186.               THEN BEGIN
  187.  
  188.                       FOR j := 1 TO 10 DO
  189.                           last [ j ] := 'f';
  190.  
  191.                       DELETE ( string_real ,i + 3, LENGTH(string_real)-(i+2) );
  192.                       len := LENGTH ( string_real );
  193.                       FOR i := 1 TO len DO
  194.                           last [ i ] := COPY ( string_real , i , 1 );
  195.                       IF len = 3  (* x.9999999999 *)
  196.                       THEN BEGIN
  197.                              IF last [ 2 ] = '9'
  198.                              THEN BEGIN
  199.                                      last [ 2 ] := '1';
  200.                                      last [ 4 ] := '0';
  201.                                      IF sign_exp = ''
  202.                                      THEN c := c + 1
  203.                                      ELSE c := c - 1;
  204.                                   END
  205.                              ELSE BEGIN
  206.                                      successor ( last [ 2 ] );
  207.                                      last [ 4 ] := '0';
  208.                                   END;
  209.                            END
  210.                       ELSE successor ( last [ len ] ); (* x.xxxx999999 *)
  211.                            (* needn't check here if last[len]=9; it CAN'T be,
  212.                               as it would have been a part of the string of 9's
  213.                             *)
  214.  
  215.                       string_real := '';
  216.                       i := 1;
  217.  
  218.                       WHILE ( last [ i ] <> 'f' ) AND ( i < 11 ) DO
  219.                                                  (* recreate string_real *)
  220.                          BEGIN
  221.                             string_real := CONCAT ( string_real , last [ i ] );
  222.                             i := i + 1;
  223.                          END;
  224.  
  225.                    END; (* then of 999999 routine *)
  226.  
  227.  
  228.  
  229.               IF NOT sci_not  (* express in expanded form *)
  230.               THEN IF sign_exp = '-'   (* mag_num < 1, mag_num <> 0 *)
  231.                    THEN BEGIN
  232.                             temp := COPY ( string_real , 1 , 1 );
  233.                             temp := CONCAT ( temp , '0.' );
  234.                             FOR i := 1 TO c - 1 DO
  235.                                 temp := CONCAT ( temp , '0' );
  236.                             DELETE ( string_real , 1 , 1 );
  237.                             DELETE ( string_real , 2 , 1 );
  238.                             string_real := CONCAT ( temp , string_real );
  239.                         END
  240.                    ELSE BEGIN
  241.                             DELETE ( string_real , 3 , 1 );
  242.                             IF ( 3 + c ) > LENGTH ( string_real )
  243.                             THEN FOR i := LENGTH( string_real ) TO ( 2 + c ) DO
  244.                                      string_real := CONCAT ( string_real ,
  245.                                                              '0' );
  246.                             INSERT ( '.' , string_real , 3 + c );
  247.                             adjust_to_specified_precision;
  248.                         END
  249.               ELSE BEGIN             (* express in scientific notation *)
  250.                         temp := '';
  251.                         IF c >= 30
  252.                         THEN BEGIN
  253.                                 temp := '3';
  254.                                 c := c - 30;
  255.                              END;
  256.                         IF c >= 20
  257.                         THEN BEGIN
  258.                                 temp := '2';
  259.                                 c := c - 20;
  260.                              END;
  261.                         IF c >= 10
  262.                         THEN BEGIN
  263.                                 temp := '1';
  264.                                 c := c - 10;
  265.                              END;
  266.                          temp := CONCAT ( temp , CHR ( c + 48 ) );
  267.  
  268.                          adjust_to_specified_precision;
  269.  
  270.                          string_real := CONCAT ( string_real , 'E' ,
  271.                                                  sign_exp , temp );
  272.                    END;
  273.           END (* begin of first then clause *)
  274.  
  275.      ELSE BEGIN   (* real_num = 0 *)
  276.  
  277.               string_real := ' 0';
  278.               FOR i := 1 to digits DO
  279.                   BEGIN
  280.  
  281.                       IF i = 1
  282.                       THEN string_real := CONCAT ( string_real , '.' );
  283.                       string_real := CONCAT ( string_real , '0' );
  284.  
  285.                   END;
  286.           END;
  287.  
  288.   END; (* REAL_TO_STRING *)
  289. BEGIN (* Dummy program for modular compilation *)
  290. END.
  291.